;;;;;;;;;;;;
; assignment
;;;;;;;;;;;;

;module
(env-push)

(defmacro assign-type-sym (_) (static-qqp (sym (str ,_ "_t"))))

(defun assign-type-t (_)
	(if (setq _ (find (first _) "bBsSiI"))
		(elem-get '(b ub s us i ui) _) ""))

(defun assign-src-type (o)
	(case (pop (type-of o))
		(:sym (if (vp-reg? o) :r :c))
		(:num :c)
		(:list
			(cond
				((vp-reg? (defq i (first o)))
					(cond
						((vp-reg? (defq i (second o)))
							(if (= 2 (length o)) :d
								(sym (cat :d (third o)))))
						((/= 2 (length o))
							(sym (cat :i (third o))))
						((num? i) :i)
						((setq i (get (assign-type-sym i)))
							(sym (cat :i (assign-type-t i))))
						(:t :i)))
				((eql i '@) :@)
				((eql i '$) :$)
				((eql i '&)
					(if (vp-reg? (second o))
						(if (vp-reg? (third o)) :&d :&i) :nil))
				(:t :c)))
		(:str :s)))

(defun assign-dst-type (o)
	(case (pop (type-of o))
		(:sym (and (not (vp-reg? o)) (eql (first o) ":") (throw ":reg equate !" o))
			(if (vp-reg? o) :r :k))
		(:list
			(if (vp-reg? (defq i (first o)))
				(cond
					((vp-reg? (defq i (second o)))
						(if (= 2 (length o)) :d
							(sym (cat :d (third o)))))
					((/= 2 (length o))
						(sym (cat :i (third o))))
					((num? i) :i)
					((setq i (get (assign-type-sym i)))
						(sym (cat :i (assign-type-t i))))
					(:t :i))))))

(defun assign-ignored-to-asm ()
	(defq s (list) d (list))
	(each (# (unless (or (eql %0 %1) (eql %1 '_)) (push s %0) (push d %1))) src dst)
	(setq src s dst d))

(defun assign-ignored-to-script ()
	(defq s (list) d (list))
	(each (# (unless (eql %1 "_") (push s %0) (push d %1))) src dst)
	(setq src s dst d))

(defun assign-topology-sort ()
	(defq s src d dst i 0 c 1000 l (dec (length d)))
	(while (and (< i l) (/= c 0))
		(if (setq j (if (list? (defq j (elem-get d i))) :nil
				(some! (lambda (s d)
					(cond
						((and (list? s) (find j s)) (!))
						((and (list? d) (find j d)) (!))
						((eql j s) (!)))) (list s d) :nil -1 (inc i))))
			(setq s (rotate s i j (inc j)) d (rotate d i j (inc j)) c (dec c))
			(++ i)))
	(if (= c 0)
		(throw "Copy cycle detected !" (list s d))
		(setq src s dst d)))

(defun assign-asm-to-asm (src dst)
	(when (/= (length src) (length dst))
		(throw "Mismatching number of src/dst parameters !" (list src dst)))
	(assign-ignored-to-asm)
	(when (> (length dst) 0)
		(if (> (length dst) 1) (assign-topology-sort))
		(each (lambda (x y)
			(case (assign-src-type x)
				(:r (case (assign-dst-type y)
					(:r (vp-cpy-rr x y))
					(:k (def *func_env* y x))
					(:i (vp-cpy-ri x (first y) (second y)))
					(:ii (vp-cpy-ri-i x (first y) (second y)))
					(:is (vp-cpy-ri-s x (first y) (second y)))
					(:ib (vp-cpy-ri-b x (first y) (second y)))
					(:iui (vp-cpy-ri-i x (first y) (second y)))
					(:ius (vp-cpy-ri-s x (first y) (second y)))
					(:iub (vp-cpy-ri-b x (first y) (second y)))
					(:d (vp-cpy-rd x (first y) (second y)))
					(:di (vp-cpy-rd-i x (first y) (second y)))
					(:ds (vp-cpy-rd-s x (first y) (second y)))
					(:db (vp-cpy-rd-b x (first y) (second y)))
					(:dui (vp-cpy-rd-i x (first y) (second y)))
					(:dus (vp-cpy-rd-s x (first y) (second y)))
					(:dub (vp-cpy-rd-b x (first y) (second y)))
					(:t (throw "Invalid dst parameter !" (list x y)))))
				(:c (vp-cpy-cr x y))
				(:i (vp-cpy-ir (first x) (second x) y))
				(:ii (vp-cpy-ir-i (first x) (second x) y))
				(:is (vp-cpy-ir-s (first x) (second x) y))
				(:ib (vp-cpy-ir-b (first x) (second x) y))
				(:iui (vp-cpy-ir-ui (first x) (second x) y))
				(:iub (vp-cpy-ir-ub (first x) (second x) y))
				(:ius (vp-cpy-ir-us (first x) (second x) y))
				(:d (vp-cpy-dr (first x) (second x) y))
				(:di (vp-cpy-dr-i (first x) (second x) y))
				(:ds (vp-cpy-dr-s (first x) (second x) y))
				(:db (vp-cpy-dr-b (first x) (second x) y))
				(:dui (vp-cpy-dr-ui (first x) (second x) y))
				(:dus (vp-cpy-dr-us (first x) (second x) y))
				(:dub (vp-cpy-dr-ub (first x) (second x) y))
				(:&i (vp-lea-i (second x) (third x) y))
				(:&d (vp-lea-d (second x) (third x) y))
				(:@ (fn-bind (second x) y))
				(:s (fn-string x y))
				(:$ (vp-lea-p (second x) y))
				(:t (throw "Invalid src parameter !" (list x y))))) src dst)))

(defun print-inst (_)
	(and (list? _) (not (lambda? (first _))) (print (ascii-char 9) _)))

(defun assign-asm-to-script (src dst _)
	(unless (= (length src) (length (setq dst (map (const trim) (split dst ",")))))
		(throw "Mismatching number of src/dst parameters !" (list src dst)))
	(assign-ignored-to-script)
	(when (/= 0 (length dst))
		(reset-reg-stack (length src))
		(each (# (cscript %0) (compile-arrow)) dst)
		(when *debug_inst*
			(print "pre opt:")
			(each (const print-inst) *inst*))
		(opt-inst-list *inst*)
		(when *debug_inst*
			(print "post opt:")
			(each (const print-inst) *inst*))
		(def-reg-map (reverse src) _)
		(eval *inst* *func_env*)))

(defun assign-script-to-asm (src dst _)
	(unless (= (length (setq src (split src ","))) (length dst))
		(throw "Mismatching number of src/dst parameters !" (list src dst)))
	(when (/= 0 (length dst))
		(reset-reg-stack 0)
		(each (# (cscript %0) (compile-deref?)) src)
		(when *debug_inst*
			(print "pre opt:")
			(each (const print-inst) *inst*))
		(opt-inst-list *inst*)
		(when *debug_inst*
			(print "post opt:")
			(each (const print-inst) *inst*))
		(def-reg-map (cat dst) _)
		(eval *inst* *func_env*)))

(defun assign-script-to-script (src dst _)
	(setq src (split src ",") dst (map (const trim) (split dst ",")))
	(unless (= (length src) (length dst))
		(throw "Mismatching number of src/dst parameters !" (list src dst)))
	(assign-ignored-to-script)
	(when (/= 0 (length dst))
		(reset-reg-stack 0)
		(each cscript src)
		(reach (# (cscript %0) (compile-arrow)) dst)
		(when *debug_inst*
			(print "pre opt:")
			(each (const print-inst) *inst*))
		(opt-inst-list *inst*)
		(when *debug_inst*
			(print "post opt:")
			(each (const print-inst) *inst*))
		(def-reg-map :nil _)
		(eval *inst* *func_env*)))

(defun assign (&optional src dst _)
	;optional src, dst, compiler regs
	(if (str? (setq src (ifn src '())))
		(if (str? (setq dst (ifn dst '())))
			(assign-script-to-script src dst _)
			(assign-script-to-asm src dst _))
		(if (str? (setq dst (ifn dst '())))
			(assign-asm-to-script src dst _)
			(assign-asm-to-asm src dst))))

;module
(export-symbols '(assign assign-src-type))
(env-pop)
